home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-error.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-07  |  8.1 KB  |  350 lines
  1. /*  $Id: pl-error.c,v 1.2 1997/08/07 07:57:47 jan Exp $
  2.  
  3.     Part of SWI-Prolog
  4.     Designed and implemented by Jan Wielemaker
  5.     E-mail: jan@swi.psy.uva.nl
  6.  
  7.     Copyright (C) 1997 University of Amsterdam. All rights reserved.
  8. */
  9.  
  10.  
  11. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  12. throw(error(<Formal>, <SWI-Prolog>))
  13.  
  14. <SWI-Prolog>    ::= context(Name/Arity, Message)
  15. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  16.  
  17. #include "pl-incl.h"
  18. #ifndef EACCES
  19. #include <errno.h>
  20. #endif
  21.  
  22. static void
  23. put_name_arity(term_t t, functor_t f)
  24. { FunctorDef fdef = valueFunctor(f);
  25.  
  26.   if ( fdef->arity == 0 )
  27.     PL_put_atom(t, fdef->name);
  28.   else
  29.   { term_t a = PL_new_term_refs(2);
  30.  
  31.     PL_put_atom(a+0, fdef->name);
  32.     PL_put_integer(a+1, fdef->arity);
  33.     PL_cons_functor(t, FUNCTOR_divide2, a+0, a+1);
  34.   }
  35. }
  36.  
  37.  
  38. int
  39. PL_error(const char *pred, int arity, const char *msg, int id, ...)
  40. { term_t except = PL_new_term_ref();
  41.   term_t formal = PL_new_term_ref();
  42.   term_t swi    = PL_new_term_ref();
  43.   va_list args;
  44.  
  45.   if ( msg == MSG_ERRNO )
  46.     msg = OsError();
  47.  
  48.                     /* build (ISO) formal part  */
  49.   va_start(args, id);
  50.   switch(id)
  51.   { case ERR_INSTANTIATION:
  52.       err_instantiation:
  53.       PL_unify_atom(formal, ATOM_instantiation_error);
  54.       break;
  55.     case ERR_TYPE:            /* ERR_INSTANTIATION if var(actual) */
  56.     { atom_t expected = va_arg(args, atom_t);
  57.       term_t actual   = va_arg(args, term_t);
  58.  
  59.       if ( PL_is_variable(actual) && expected != ATOM_variable )
  60.     goto err_instantiation;
  61.  
  62.       PL_unify_term(formal,
  63.             PL_FUNCTOR, FUNCTOR_type_error2,
  64.               PL_ATOM, expected,
  65.               PL_TERM, actual);
  66.       break;
  67.     }
  68.     case ERR_AR_TYPE:            /* arithmetic type error */
  69.     { atom_t expected = va_arg(args, atom_t);
  70.       Number num      = va_arg(args, Number);
  71.       term_t actual   = PL_new_term_ref();
  72.  
  73.       _PL_put_number(actual, num);
  74.       PL_unify_term(formal,
  75.             PL_FUNCTOR, FUNCTOR_type_error2,
  76.               PL_ATOM, expected,
  77.               PL_TERM, actual);
  78.       break;
  79.     }
  80.     case ERR_AR_UNDEF:
  81.     { PL_unify_term(formal,
  82.             PL_FUNCTOR, FUNCTOR_evaluation_error1,
  83.               PL_ATOM, ATOM_undefined);
  84.       break;
  85.     }
  86.     case ERR_AR_OVERFLOW:
  87.     { PL_unify_term(formal,
  88.             PL_FUNCTOR, FUNCTOR_evaluation_error1,
  89.               PL_ATOM, ATOM_float_overflow);
  90.       break;
  91.     }
  92.     case ERR_AR_UNDERFLOW:
  93.     { PL_unify_term(formal,
  94.             PL_FUNCTOR, FUNCTOR_evaluation_error1,
  95.               PL_ATOM, ATOM_float_underflow);
  96.       break;
  97.     }
  98.     case ERR_DOMAIN:            /*  ERR_INSTANTIATION if var(arg) */
  99.     { atom_t domain = va_arg(args, atom_t);
  100.       term_t arg    = va_arg(args, term_t);
  101.  
  102.       if ( PL_is_variable(arg) )
  103.     goto err_instantiation;
  104.  
  105.       PL_unify_term(formal,
  106.             PL_FUNCTOR, FUNCTOR_domain_error2,
  107.               PL_ATOM, domain,
  108.               PL_TERM, arg);
  109.       break;
  110.     }
  111.     case ERR_REPRESENTATION:
  112.     { atom_t what = va_arg(args, atom_t);
  113.  
  114.       PL_unify_term(formal,
  115.             PL_FUNCTOR, FUNCTOR_representation_error1,
  116.               PL_ATOM, what);
  117.       break;
  118.     }
  119.     case ERR_MODIFY_STATIC_PROC:
  120.     { Procedure proc = va_arg(args, Procedure);
  121.       term_t pred = PL_new_term_ref();
  122.  
  123.       unify_definition(pred, proc->definition, 0, GP_NAMEARITY);
  124.       PL_unify_term(formal,
  125.             PL_FUNCTOR, FUNCTOR_permission_error3,
  126.               PL_ATOM, ATOM_modify,
  127.               PL_ATOM, ATOM_static_procedure,
  128.               PL_TERM, pred);
  129.       break;
  130.     }
  131.     case ERR_UNDEFINED_PROC:
  132.     { Definition def = va_arg(args, Definition);
  133.       term_t pred = PL_new_term_ref();
  134.  
  135.       unify_definition(pred, def, 0, GP_NAMEARITY);
  136.       PL_unify_term(formal,
  137.             PL_FUNCTOR, FUNCTOR_existence_error2,
  138.               PL_ATOM, ATOM_procedure,
  139.               PL_TERM, pred);
  140.       break;
  141.     }
  142.     case ERR_FAILED:
  143.     { Procedure proc = va_arg(args, Procedure);
  144.       term_t pred = PL_new_term_ref();
  145.  
  146.       unify_definition(pred, proc->definition, 0, GP_NAMEARITY);
  147.       PL_unify_term(formal,
  148.             PL_FUNCTOR, FUNCTOR_failure_error1,
  149.               PL_TERM, pred);
  150.  
  151.       break;
  152.     }
  153.     case ERR_EVALUATION:
  154.     { atom_t what = va_arg(args, atom_t);
  155.  
  156.       PL_unify_term(formal,
  157.             PL_FUNCTOR, FUNCTOR_evaluation_error1,
  158.               PL_ATOM, what);
  159.       break;
  160.     }
  161.     case ERR_NOT_EVALUABLE:
  162.     { functor_t f = va_arg(args, functor_t);
  163.       term_t actual = PL_new_term_ref();
  164.  
  165.       put_name_arity(actual, f);
  166.       
  167.       PL_unify_term(formal,
  168.             PL_FUNCTOR, FUNCTOR_type_error2,
  169.               PL_ATOM, ATOM_evaluable,
  170.               PL_TERM, actual);
  171.       break;
  172.     }
  173.     case ERR_DIV_BY_ZERO:
  174.     { PL_unify_term(formal,
  175.             PL_FUNCTOR, FUNCTOR_evaluation_error1,
  176.               PL_ATOM, ATOM_zero_divisor);
  177.       break;
  178.     }
  179.     case ERR_PERMISSION:
  180.     { atom_t type = va_arg(args, atom_t);
  181.       atom_t op   = va_arg(args, atom_t);
  182.       term_t obj  = va_arg(args, term_t);
  183.  
  184.       PL_unify_term(formal,
  185.             PL_FUNCTOR, FUNCTOR_permission_error3,
  186.               PL_ATOM, type,
  187.               PL_ATOM, op,
  188.               PL_TERM, obj);
  189.  
  190.       break;
  191.     }
  192.     case ERR_EXISTENCE:
  193.     { atom_t type = va_arg(args, atom_t);
  194.       term_t obj  = va_arg(args, term_t);
  195.  
  196.       PL_unify_term(formal,
  197.             PL_FUNCTOR, FUNCTOR_existence_error2,
  198.               PL_ATOM, type,
  199.               PL_TERM, obj);
  200.  
  201.       break;
  202.     }
  203.     case ERR_FILE_OPERATION:
  204.     { atom_t action = va_arg(args, atom_t);
  205.       atom_t type   = va_arg(args, atom_t);
  206.       term_t file   = va_arg(args, term_t);
  207.  
  208.       switch(errno)
  209.       { case EACCES:
  210.       PL_unify_term(formal,
  211.             PL_FUNCTOR, FUNCTOR_permission_error3,
  212.               PL_ATOM, action,
  213.               PL_ATOM, type,
  214.               PL_TERM, file);
  215.       break;
  216.     case EMFILE:
  217.     case ENFILE:
  218.       PL_unify_term(formal,
  219.             PL_FUNCTOR, FUNCTOR_representation_error1,
  220.               PL_ATOM, ATOM_max_files);
  221.       break;
  222.     default:            /* what about the other cases? */
  223.       PL_unify_term(formal,
  224.             PL_FUNCTOR, FUNCTOR_existence_error2,
  225.               PL_ATOM, type,
  226.               PL_TERM, file);
  227.       break;
  228.       }
  229.  
  230.       break;
  231.     }
  232.     case ERR_STREAM_OP:
  233.     { atom_t action = va_arg(args, atom_t);
  234.       term_t stream = va_arg(args, term_t);
  235.       
  236.       PL_unify_term(formal,
  237.             PL_FUNCTOR, FUNCTOR_io_error2,
  238.               PL_ATOM, action,
  239.               PL_TERM, stream);
  240.       break;
  241.     }
  242.     case ERR_NOTIMPLEMENTED:        /* non-ISO */
  243.     { atom_t what = va_arg(args, atom_t);
  244.  
  245.       PL_unify_term(formal,
  246.             PL_FUNCTOR, FUNCTOR_not_implemented_error1,
  247.               PL_ATOM, what);
  248.       break;
  249.     }
  250.     case ERR_RESOURCE:
  251.     { atom_t what = va_arg(args, atom_t);
  252.  
  253.       PL_unify_term(formal,
  254.             PL_FUNCTOR, FUNCTOR_not_implemented_error1,
  255.               PL_ATOM, what);
  256.       break;
  257.     }
  258.     case ERR_NOMEM:
  259.     { PL_unify_term(formal,
  260.             PL_FUNCTOR, FUNCTOR_resource_error1,
  261.               PL_ATOM, ATOM_no_memory);
  262.  
  263.       break;
  264.     }
  265.     case ERR_SYSCALL:
  266.     { atom_t op = va_arg(args, atom_t);
  267.  
  268.       if ( !msg )
  269.     msg = PL_atom_chars(op);
  270.  
  271.       switch(errno)
  272.       { case ENOMEM:
  273.       PL_unify_term(formal,
  274.             PL_FUNCTOR, FUNCTOR_resource_error1,
  275.               PL_ATOM, ATOM_no_memory);
  276.       break;
  277.     default:
  278.       PL_unify_atom(formal, ATOM_system_error);
  279.       break;
  280.       }
  281.  
  282.       break;
  283.     }
  284.     case ERR_SHELL_FAILED:
  285.     { term_t cmd = va_arg(args, term_t);
  286.  
  287.       PL_unify_term(formal,
  288.             PL_FUNCTOR, FUNCTOR_shell2,
  289.               PL_ATOM, ATOM_execute,
  290.               PL_TERM, cmd);
  291.       break;
  292.     }
  293.     case ERR_SHELL_SIGNALLED:
  294.     { term_t cmd = va_arg(args, term_t);
  295.       int sig = va_arg(args, int);
  296.  
  297.       PL_unify_term(formal,
  298.             PL_FUNCTOR, FUNCTOR_shell2,
  299.               PL_FUNCTOR, FUNCTOR_signal1,
  300.                 PL_INTEGER, sig,
  301.               PL_TERM, cmd);
  302.       break;
  303.     }
  304.     default:
  305.       assert(0);
  306.   }
  307.   va_end(args);
  308.  
  309.                     /* build SWI-Prolog context term */
  310.   if ( pred || msg )
  311.   { term_t predterm = PL_new_term_ref();
  312.     term_t msgterm  = PL_new_term_ref();
  313.  
  314.     if ( pred )
  315.     { PL_unify_term(predterm,
  316.             PL_FUNCTOR, FUNCTOR_divide2,
  317.               PL_CHARS, pred,
  318.               PL_INTEGER, arity);
  319.     }
  320.     if ( msg )
  321.     { PL_put_atom_chars(msgterm, msg);
  322.     }
  323.  
  324.     PL_unify_term(swi,
  325.           PL_FUNCTOR, FUNCTOR_context2,
  326.             PL_TERM, predterm,
  327.             PL_TERM, msgterm);
  328.   }
  329.  
  330.   PL_unify_term(except,
  331.         PL_FUNCTOR, FUNCTOR_error2,
  332.           PL_TERM, formal,
  333.           PL_TERM, swi);
  334.  
  335.  
  336.   return PL_throw(except);
  337. }
  338.  
  339.  
  340. char *
  341. tostr(char *buf, const char *fmt, ...)
  342. { va_list args;
  343.  
  344.   va_start(args, fmt);
  345.   Svsprintf(buf, fmt, args);
  346.   va_end(args);
  347.   
  348.   return buf;
  349. }
  350.